(*$L-#6:*)
(*$S+*)
PROGRAM BLACKJK;
 
 {GAME OF BLACKJACK WRITTEN IN PASCAL BY T.R. STOKES}
 {MODIFICATIONS TO PERMIT S(piltpair AND Q(uit ADDED BY 
  G. W. SCHREYER  8-NOV-80}
 {Further modifications to permit doubling down on a split and
  to allow insurance and a better random number generator added
  by G.W. Schreyer 15-Dec-80}
 {Even further modified to burn a card.  GWS 16-DEC-80}
 {Tens ratio stuff added 19-Dec-80 and revised 23-Dec-80  gws}
                                  {and revised again 24-Dec-80 gws}
                                  {and commented out 7-Apr-81 because
                                   it never did work just right}
 {An original bug in procedure score fixed 26-Dec-80  gws}
 
 CONST
  VERSION = 'blackjack  version 3.0    26 Dec 82';
  XINST =       10; {VARIOUS X-Y COORDS FOR SCREEN MESSAGES}
  YINST =        3;
  XWIN  =       11;
  YWIN  =        2;
  XBET  =        8;
  YBET  =        1;
  YHAND0=        6; {LEVEL-1 OF CARDS PLAYED}
  
 TYPE
  VEGAS =       (PLAYER,DEALER);
  
 VAR
  NOTTEN,NUMTENS        :INTEGER;
  TENS_RATIO            :REAL;
  DECK                  :ARRAY[1..52] OF INTEGER;
  CARD,HI,LO,LO_AGAIN   :INTEGER;
  RANK,SUIT             :INTEGER;
  DBLDOWN3              :BOOLEAN;
  CHANGED_BET           :BOOLEAN;
  NAMRANK,NAMSUIT       :STRING;
  CARDSLEFT             :INTEGER;
  SEED                  :INTEGER;
  PERSON                :VEGAS;
  HANDVAL               :ARRAY[1..3] OF INTEGER;
  HANDSIZE              :ARRAY[1..3] OF INTEGER;
  TBET,BET,DOLLARS      :INTEGER;
  BUST,BJACK,PUSH,WIN   :BOOLEAN;
  XPLYR,YPLYR           :INTEGER;
  XDELR,YDELR           :INTEGER;
  XSPLIT,YSPLIT         :INTEGER;
  I,J,Q                 :INTEGER; {GENERAL PURPOSE INDICES}
  NUMACES               :ARRAY[1..3] OF INTEGER;
  WAIT                  :INTEGER;
  SHUFFLED_SINCE_HOLCARD:BOOLEAN;
  JUST_SHUFFLED         :BOOLEAN;
  CARDVAL               :INTEGER;
  REPLY                 :CHAR;
  HOLVAL,XRANK          :INTEGER;
  HOLCARD               :BOOLEAN;
  CHOICE                :SET OF CHAR;
  XHOLE,YHOLE           :INTEGER;
  HOLSUIT,HOLRANK       :STRING;
  DBLDOWN,PAIR,SPLIT    :BOOLEAN;
  SPLITHAND,DBLBUST     :BOOLEAN;
  FSTCARD               :INTEGER;
  THIRDCARD,FIRSTCARD   :INTEGER;
  BUSTFIRST,BUSTSECOND  :BOOLEAN;
  XOVER,YOVER           :INTEGER;
  ACEUP                 :BOOLEAN;
  INSBET                :INTEGER;
  CARD_ON_TABLE         :ARRAY[1..52] OF BOOLEAN;
  CARD_NOT_IN_DECK      :ARRAY[1..52] OF BOOLEAN;
  CARDS_NOT_SEEN        :INTEGER;
  
  
PROCEDURE SQUAWK;
  BEGIN
    WRITE(CHR(7));
  END;

procedure clear_line ( x, y : integer );
begin
   gotoxy ( x, y );
   write ( chr ( 27 ) , 'K' );  {H-19}
end;

procedure clear_screen ( x, y : integer );
begin
   gotoxy ( x, y );
   write ( chr ( 27 ) , 'J' );  {H-19}
end;

PROCEDURE TENCOUNT;
 BEGIN
   IF HOLCARD THEN XRANK:=HOLVAL ELSE XRANK:=RANK;
   IF (XRANK>9) AND (XRANK<14) THEN NUMTENS:=NUMTENS-1
     ELSE NOTTEN:=NOTTEN-1;
   IF NUMTENS=0 THEN TENS_RATIO:=99.999 ELSE TENS_RATIO:=NOTTEN/NUMTENS;
   CLEAR_LINE(60,9);
   WRITE('Tens ratio');
   CLEAR_LINE ( 62, 11 );
   WRITE(NOTTEN:2,'/',NUMTENS:2);
   CLEAR_LINE(61,12);
   WRITE(TENS_RATIO:5:3);
   CLEAR_LINE(60,15);
   WRITE('Cards left');
   CLEAR_LINE(65,17);
   WRITE(CARDSLEFT);
 END;
 
 PROCEDURE RANSUIT(VAR CARD:INTEGER); FORWARD;
 
 PROCEDURE COUNTERFIX;
   BEGIN
     RANSUIT(CARD);
     {TENCOUNT;}
   END;

PROCEDURE CLEARTOP;
  BEGIN
    CLEAR_LINE(0,0);
  END;
   
   
PROCEDURE SHUFMES;
 BEGIN
  CLEARTOP;
  GOTOXY(5,0);
  WRITE('SHUFFLING-  HAVE A DRINK ON THE HOUSE.');
  FOR WAIT:=1 TO 2000 DO WAIT:=WAIT;
 END;  {SHUFMES}
  
FUNCTION RND:REAL;
 BEGIN
  RND:=SEED/32767;
  SEED:=(103*SEED+1999) MOD 32767;
  IF SEED<0 THEN SEED:=SEED*(-1);
 END; {RND}
 
PROCEDURE FRESHDECK;
 BEGIN
  FOR I:=1 TO 52 DO
   BEGIN
    DECK[I]:=I;
  END; {FOR}
 END;  {FRESHDECK}
 
PROCEDURE NAMECARD;
 BEGIN
  NAMRANK:='     ';         {MAKE IT ONE BYTE LONG}
  NAMRANK[1]:=CHR(RANK+48);   {SO THIS WILL WORK}
  IF RANK=1 THEN NAMRANK:='ACE  '
   ELSE IF RANK>9 THEN
    BEGIN
     CASE RANK OF
    10:NAMRANK:='10   ';
    11:NAMRANK:='JACK ';
    12:NAMRANK:='QUEEN';
    13:NAMRANK:='KING ';
     END {RANKCASE}
    END;
    BEGIN
     CASE SUIT OF
    1:NAMSUIT:='CLUBS   ';
    2:NAMSUIT:='DIAMONDS';
    3:NAMSUIT:='HEARTS  ';
    4:NAMSUIT:='SPADES  ';
     END {SUITCASE}
    END;
   END; {NAMECARD}

PROCEDURE RANSUIT;
 BEGIN
   RANK:=CARD MOD 13;
   IF RANK=0 THEN RANK:=13;
   SUIT:=(CARD-1) DIV 13 + 1;
 END; {RANSUIT}

PROCEDURE BURN;
 VAR T:INTEGER;
 BEGIN
   REPEAT
     CARD:=DECK[CARDSLEFT];
     IF CARD_NOT_IN_DECK[CARD] THEN COUNTERFIX;
     CARDSLEFT:=CARDSLEFT-1;
   UNTIL CARD_NOT_IN_DECK[CARD]=FALSE;
   RANSUIT(CARD);
   NAMECARD;
   GOTOXY(5,0);
   WRITE('Burning a');
   IF (RANK=8) OR (RANK=1) THEN WRITE('n');
   WRITE(' ',NAMRANK:6,' of ',NAMSUIT);
   FOR T:= 1 TO 5000 DO T:=T;
   CLEARTOP;
   HOLCARD:=FALSE;
   {TENCOUNT;}
 END;
 
PROCEDURE SHUFFLE;
 VAR
  TEMP,RI:INTEGER;
 BEGIN
  SHUFMES;
  FOR I:=1 TO 52 DO CARD_NOT_IN_DECK[I]:=CARD_ON_TABLE[I];
  CARDSLEFT:=52;
   FOR I:=1 TO 52 DO
    BEGIN
     TEMP:=DECK[I];
     RI:=TRUNC(52*RND+1);
     DECK[I]:=DECK[RI];
     DECK[RI]:=TEMP;
    END; {FOR}
   CLEARTOP;
   NOTTEN:=36;
   NUMTENS:=16;
   BURN;
   CARDS_NOT_SEEN:=0;
   JUST_SHUFFLED:=TRUE;
  END; {SHUFFLE}
  
PROCEDURE NOTSEEN;
  BEGIN
    IF NOT SHUFFLED_SINCE_HOLCARD AND (BUST OR (SPLIT AND DBLBUST)) THEN
      BEGIN
        CARDS_NOT_SEEN:=CARDS_NOT_SEEN+1;
      END;
    CLEAR_LINE(58,20);
    WRITE('Cards not seen');
    CLEAR_LINE(65,22);
    WRITE(CARDS_NOT_SEEN);
  END;
   
PROCEDURE SETUP;
 BEGIN
  BUST:=FALSE;
  DBLDOWN3:=FALSE;
  TENS_RATIO:=0;
  BJACK:=FALSE;
  SHUFFLED_SINCE_HOLCARD:=FALSE;
  JUST_SHUFFLED:=FALSE;
  ACEUP:=FALSE;
  FOR I:=1 TO 52 DO CARD_ON_TABLE[I]:=FALSE;
  INSBET:=0;
  DBLBUST:=FALSE;
  SPLITHAND:=FALSE;
  BUSTFIRST:=FALSE;
  BUSTSECOND:=FALSE;
  Q:=0;
  PUSH:=FALSE;
  WIN:=FALSE;
  DBLDOWN:=FALSE;
  FSTCARD:=0;
  PAIR:=FALSE;
  SPLIT:=FALSE;
  XOVER:=5;
  YOVER:=4;
  XPLYR:=0;
  YPLYR:=YHAND0;
  XDELR:=26;
  YDELR:=YHAND0;
  XSPLIT:=0;
  YSPLIT:=YHAND0+9;
  FOR I:=1 TO 3 DO
   BEGIN
    HANDVAL[I]:=0;
    NUMACES[I]:=0;
    HANDSIZE[I]:=0;
   END; {FOR}
 END; {SETUP}
 
 PROCEDURE SHOWHAND;
  VAR
   X,Y,CN  :INTEGER;
  BEGIN
   CASE PERSON OF
  PLAYER:
   BEGIN
    YPLYR:=YPLYR+1;
    Y:=YPLYR;
    X:=XPLYR;
   END;
  DEALER:
   BEGIN
    YDELR:=YDELR+1;
    Y:=YDELR;
    X:=XDELR;
    IF SPLIT THEN YSPLIT:=YHAND0;
   END;
  END; {CASE}
   NAMECARD;
   GOTOXY(X,Y);
   CN:=Y-YHAND0;
   IF SPLITHAND THEN CN:=Y-YSPLIT;
   WRITE(CN:3,')',NAMRANK:6,' OF ',NAMSUIT);
   HOLCARD:=FALSE;
 END; {SHOWHAND}
  
PROCEDURE SCORE;
 VAR CARDVAL:INTEGER;
BEGIN
  CASE PERSON OF
  PLAYER:IF SPLITHAND THEN I:=3 ELSE I:=1;
  DEALER:I:=2;
   END; {CASE}
 CARDVAL:=RANK;
 IF RANK>10 THEN CARDVAL:=10;
 IF RANK=1 THEN 
   BEGIN
     CARDVAL:=11;
     NUMACES[I]:=NUMACES[I]+1;
   END;
 HANDVAL[I]:=HANDVAL[I]+CARDVAL;
 WHILE (HANDVAL[I]>21) AND (NUMACES[I]>0) DO 
   BEGIN
      HANDVAL[I]:=HANDVAL[I]-10;
      NUMACES[I]:=NUMACES[I]-1;
   END;
IF HANDVAL[I]>21 THEN BUST:=TRUE;
END; {SCORE}

PROCEDURE PSCORE;
 BEGIN
  IF SPLITHAND THEN I:=3 ELSE I:=1;
  GOTOXY(XPLYR+6,YPLYR+1);
  WRITE('TOTAL = ',HANDVAL[I]:3);
 END; {PSCORE}
 
PROCEDURE HSCORE;
 BEGIN
  GOTOXY(XDELR+6,YDELR+1);
  WRITE('TOTAL = ',HANDVAL[2]:3);
 END; {HSCORE}

PROCEDURE WINNINGS;
 BEGIN
  IF NOT PUSH THEN
   BEGIN
    TBET:=BET;
    IF DBLBUST THEN DOLLARS:=DOLLARS-BET;
    IF DBLDOWN AND (NOT SPLITHAND) THEN TBET:=BET+BET;
    IF DBLDOWN3 THEN TBET:=BET+BET;
    IF WIN THEN DOLLARS:=DOLLARS+TBET
    ELSE DOLLARS:=DOLLARS-TBET
  END;
  CLEAR_LINE(XWIN,YWIN);
  WRITE('In U.S. of A. Dollars you have $',DOLLARS);
 END; {WINNINGS}
 
PROCEDURE DOWHAT;
 BEGIN
  CLEAR_LINE(XOVER,YOVER);
  REPEAT
   GOTOXY(XOVER,YOVER);
   WRITE('YOUR MONEY ? ');
   READ(REPLY);
   IF REPLY IN [ 'a'..'z' ] THEN REPLY := CHR ( ORD ( REPLY ) - 32 );
   CLEAR_LINE(XOVER,YOVER+1);
  UNTIL REPLY IN CHOICE;
  IF (REPLY='D') AND (HANDSIZE[1]>2) AND (NOT SPLIT) THEN
   BEGIN
    CLEAR_LINE(XOVER,YOVER+1);
    WRITE('NO-NO, NOT AFTER 3 OR MORE!!');
    SQUAWK;
    DOWHAT;
   END;
  IF (REPLY='S') AND (NOT PAIR) THEN
   BEGIN
    CLEAR_LINE (XOVER,YOVER+1);
    WRITE ('YOU DON''T HAVE A PAIR TO SPLIT!');
    SQUAWK;
    DOWHAT;
   END;
    IF SPLIT AND (REPLY='S') THEN
     BEGIN
      CLEAR_LINE(XOVER,YOVER+1);
      WRITE('YOU CAN''T SPLIT A SPLIT PAIR!');
      SQUAWK;
      DOWHAT;
     END;
     END; {DOWHAT}
 
PROCEDURE NOSHOW;
 VAR CN:INTEGER;
 BEGIN
  YDELR:=YDELR+1;
  GOTOXY(XDELR,YDELR);
  CN:=YDELR-YHAND0;
  WRITE(CN:3,')   ?????????');
  XHOLE:=XDELR;
  YHOLE:=YDELR;
  HOLSUIT:=NAMSUIT;
  HOLRANK:=NAMRANK;
  HOLVAL:=RANK;
 END; {NOSHOW}
 
PROCEDURE INSTRUCTIONS;
 BEGIN
  GOTOXY(XINST,YINST);
  WRITE('H)it, G)ood, D)oubledown, S)plitpair, Q(uit');
 END; {INSTRUCTIONS}
 
PROCEDURE PLAYERIN;
 VAR C,B:CHAR;
BEGIN
  (*$I-*)
 CLEAR_LINE(XBET,YBET);
 IF (NOT CHANGED_BET) AND (BET<>0) THEN
    BEGIN
       WRITE('HOUSE LIMIT IS $200.. BET LIMIT ? (Y/N) ');
       READ(B);
       IF B<>'N' THEN BET:=200 ELSE BET:=0;
    END
 ELSE
  BEGIN
   CHANGED_BET:=TRUE;
   REPEAT
     CLEAR_LINE(XBET,YBET);
     IF BET=0 THEN
      BEGIN
        REPEAT
          CLEAR_LINE(XBET,YBET);
(*$I BJACK.1.TEXT*)

